home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d12
/
v10n02.arc
/
FOXIDX.PRG
< prev
next >
Wrap
Text File
|
1991-01-10
|
5KB
|
144 lines
* FOXIDX.PRG
* Display some information for all .IDX files
* in the current directory
*
PROCEDURE FoxIdx
PRIVATE filespec, idxname
filespec = "*.IDX" && Change to ".NDX" if
&& INDEX=NDX in CONFIG.FP
idxname = SYS(2000, filespec) && Find first matching file
DO WHILE ! EMPTY(idxname) && For each match
DO PrintInfo WITH idxname && Print some info
idxname = SYS(2000, filespec, 1) && Find next matching
ENDDO
RETURN
* PROCEDURE PrintInfo
* Print some info for the FoxPro index file whose
* name was passed as a parameter
*
PROCEDURE PrintInfo && Print some info
PARAMETERS iname && Name of idx file
PRIVATE ikey, ifor
?
? "Filename: "+iname
ikey = IdxKey(iname) && Get index key
IF ("" == ikey) && If it is null
IF FERROR() # 0 && Check for error
ikey = "Error: "+FerrorTxt(ferror())
ENDIF
ENDIF
? "Key: "+ikey
IF IsKeyFor(iname) && If index has FOR clause
ifor = KeyFor(iname) && Get it
IF ("" == ifor) && If it is null
IF FERROR() # 0 && Check for error
ifor = "Error: "+FerrorTxt(ferror())
ENDIF
ENDIF
? "FOR clause: "+ifor
ELSE && No FOR clause
IF FERROR() # 0 && Check for error
ifor = "Error: "+FerrorTxt(ferror())
? "FOR clause: "+ifor
ELSE
? "FOR clause: "+"*none*"
ENDIF
ENDIF
RETURN
* FUNCTION FerrorTxt(error number from FERROR())
* Return the text for the associated error number
* returned from FERROR()
*
FUNCTION FerrorTxt
PARAMETER errno
DO CASE
CASE errno = 2
RETURN "File not found"
CASE errno = 4
RETURN "Too many files open (insufficient handles)"
CASE errno = 5
RETURN "Access denied"
CASE errno = 6
RETURN "Invalid file handle"
CASE errno = 8
RETURN "Out of memory"
CASE errno = 25
RETURN "Seek past beginning of file"
CASE errno = 29
RETURN "Disk full"
CASE errno = 31
RETURN "Error opening file, or EOF encountered"
OTHERWISE
RETURN "Unknown error"
ENDCASE
RETURN
* FUNCTION KeyFor("index filename")
* Return the FOR expression for a FoxPro index file.
*
FUNCTION KeyFor && Return FOR clause
PARAMETERS idxname && Index filename
PRIVATE handle, forclause
handle = FOPEN(idxname,10) && Open for read only
IF handle = -1 && -1 means error
RETURN "" && So set it to null string
ENDIF
= FSEEK(handle,236,0) && Goto byte pos 236
forclause = TRIM(FREAD(handle,220)) && Read the FOR clause
IF FERROR() # 0 && If error occurred
forclause="" && Set it to null string
ENDIF
=FCLOSE(handle) && Close the file
forclause = SUBSTR(forclause,1,;
AT(CHR(0),forclause)) && Remove trailing nulls
RETURN forclause && Return result
*
* FUNCTION IsKeyFor("Index Filename")
* Return .T. if FoxPro index has a FOR clause, .F. otherwise.
*
FUNCTION IsKeyFor
PARAMETERS idxname && Index filename
PRIVATE handle, retcode
retcode = .F. && Init to false
handle = FOPEN(idxname,10) && Open for read only
IF handle = -1 && -1 means error
RETURN retcode && So set it to FALSE
ENDIF
= FSEEK(handle,14,0) && Goto byte pos 14
iopt = FREAD(handle,1) && Get index options
IF FERROR() # 0 && If error occurred
retcode=.F. && Set it to FALSE
ENDIF
=FCLOSE(handle) && Close the file
IF (iopt == CHR(8)) .OR. (iopt == CHR(9))
retcode = .T. && 8 or 9 if there
ENDIF && is a FOR clause
RETURN retcode && Return result
* FUNCTION IdxKey("index filename")
* Return the KEY expression for a FoxPro index.
*
FUNCTION IdxKey && Return FOR clause
PARAMETERS idxname && Index filename
PRIVATE handle, keyclause
handle = FOPEN(idxname,10) && Open for read only
IF handle == -1 && -1 means error
RETURN "" && So set it to null string
ENDIF
= FSEEK(handle,16,0) && Goto byte pos 16
keyclause = TRIM(FREAD(handle,220)) && Read the KEY clause
IF FERROR() # 0 && If error occurred
keyclause="" && Set it to null string
ENDIF
=FCLOSE(handle) && Close the file
keyclause = SUBSTR(keyclause,1,;
AT(CHR(0),keyclause)) && Remove trailing nulls
RETURN keyclause && Return result